C ***** SCANNER *************************  
C* SCANR,BGSORT,FMT,RANR,SQYY,COLTTY,READER,CLEAN,ACCEL,POINTR,PARAM,ALL  7/78
	SUBROUTINE SCANR

	DIMENSION IP(15)
C IP LIMITS NUMBER OF DIGITS IN A FLOATING POINT NUM.
	COMMON J,L /DUR/DUR(27) /ALPH/IALPH(14),ISCA(12),IDAT(11)
	1/E/IQ(27),ISKP,XMINUS,AN,IEXP,LK,NNUM,JJ,JA,ISUB,NFLG
	1 ,VX(70),IAMP,K,KN,M,ML,CODE /INP/INP(1)
	1 /BLA/IBLA,KSLA,ISEMI,MINUS,ISTAR,ICOMM,ICOL,IQUES,ILESS,IQT
	EQUIVALENCE(IFF,ISCA(6)),(ISS,ISCA(9)),(IEE,ISCA(5)),
	1 (IDOT,IDAT(11)),(III,IALPH(2)),(IRR,IALPH(9)),(IXX,IALPH(13))
	1 ,(INN,ISCA(4)),(IP,PL),(I0,IDAT),(I9,IDAT(10)),(IPP,ISCA(2))
      NNUM=-1     
      ISKP=0
      JJ=0  
	XMINUS=1.    
	KPAR=0
999      IDECI=-1  
      M=0   
2799	N=INP(ML)
	IF(N.NE.IQT)GO TO 899
	JA=-1
	ML=ML+1
	ISUB=8
	JJ=JJ+1
	VX(JJ)=ML
C  POINTS TO FIRST LIT. CHAR.
	DO 1177 K=ML,144
	IF(INP(K).NE.IQT)GO TO 1177
	ML=K+1
2177	N=INP(ML)
	GO TO 899
1177	CONTINUE
C  SKIPS 'LIT' ITEMS IN RAN. SELECTION
899   ML=ML+1
	IF(N.EQ.ICOL)GO TO 751
	IF(N.EQ.ISEMI)GO TO 751
	IF(N.NE.IBLA)GO TO 510
4702      IF(ISKP)202,2799,2799

510	IF(N.NE.IPP)GO TO 4511
C CATCH PARAM NUMS. GO UP AND CHANGE TO MAGIC NUMBER.
	K=INP(ML)
	IF(K.LT.I0.OR.K.GT.I9)GO TO 4511
	KPAR=-1
	JA=0
C JA=0 SO SCANR WILL FIND NOTES OR NUMS LATER.
	GO TO 2177
4511	IF(JA)GO TO 70
      DO 77 K=1,12   
      IF(N.NE.ISCA(K))GO TO 77
	IF(K.EQ.2)GO TO 1511
C P=PROXIMITY MODE -- OR A PARAM NUM.
C ERROR IF NO NUM AFTER P WHEN ONLY NUMS ARE EXPECTED.
C FINDS PARAMETER NUMBER (E.G. P13) USED AS A SIMPLE NUMBER. (KPAR IS FLAG)
1510	IF(K.NE.4)GO TO 511
C K=2=P, =4=O ('ORDINARY')
1511	NSWCH=K-4
	GO TO 2177
C  TO SWITCH ALWAYS USE OCT.#  /PBF4/  /OE5/  P=PROXIMITY, O=ORDINARY
511   NNUM=K
	JJ=JJ+1
	NFLG=-1
	N=INP(ML)
	IF(N.NE.IFF)GO TO 410
	NNUM=NNUM-1
	GO TO 610
410	IF(N.NE.ISS)GO TO 3410
	NNUM=NNUM+1
610	ML=ML+1
	N=INP(ML)
3410	IF(N.EQ.INN)GO TO 3411
	IF(N.NE.III)GO TO 371
C  'END' OR 'FINE' WILL END INST.
3411	VX(JJ)=-10000.
	IF(DUR(LK).LT.0)DUR(LK)=10000.
	IAMP=-1
	RETURN
371	IF(N.EQ.ISEMI)GO TO 5410
	IF(N.EQ.IBLA)GO TO 5410
	DO 177 KN=1,10
	IF(N.NE.IDAT(KN))GO TO 177
	JSCA=KN-1
	ML=ML+1
	GO TO 2410
177	CONTINUE
	GO TO 6410
5410	KN=-1
6410	IF(NSWCH.EQ.0)GO TO 2410
	IF(KN.LT.0)GO TO 7410
C /B/B-/ JUMPS DOWN OCT., /B/B+/ UP OCT.
7410	IF(NOLD-NNUM.LE.5)GO TO 7411
	IF(JSCA.LT.7)JSCA=JSCA+1
7411	IF(NOLD-NNUM.GE.-5)GO TO 2410
	IF(JSCA.GT.0)JSCA=JSCA-1
C   WILL JUMP TO NEAREST NOTE ***********  MAY 22,71
2410	VX(JJ)=JSCA*12+NNUM
	NOLD=NNUM
4410	NNUM=-2
	IF(INP(ML).EQ.ISEMI)RETURN
C   ABOVE FINDS SCALE NOTES; IF NSWCH=0 OCT. NUM WILL STICK UNTIL RESET
	IF(N.EQ.IXX)GO TO 210
	IF(N.EQ.ISTAR)GO TO 210
	GO TO 310
77    CONTINUE    
70    IF(N.NE.MINUS)GO TO 71   
      XMINUS=-1.   
      GO TO 2799   
210	JJ=JJ+1
	IF(JJ.EQ.1)GO TO 3310
	XMINUS=1.
	VX(JJ)=0
C  'X N1,N2' MAY REPLACE 'REP N1,N2'.  N2=0 BECOMES N2=2
	GO TO 310
71	IF(N.EQ.IXX)GO TO 210
	IF(N.EQ.ISTAR)GO TO 210
	IF(N.EQ.IRR)GO TO 73     

1410  DO 78 K=1,11
      IF(N.NE.IDAT(K))GO TO 78
	ISKP=-1
	IF(N.NE.IDOT)GO TO 79
	IDECI=M
	GO TO 75
79    M=M+1 
      IP(M)=K-1   
	GO TO 75
78	CONTINUE
	IF(N.NE.IEE)GO TO 8811
	IF(INP(ML).NE.INN)GO TO 781
	GO TO 7811
8811	IF(N.NE.IFF)GO TO 781
	IF(INP(ML).NE.III)GO TO 781
C  'EN(D)' OR 'FI(NE)' WILL END INST.
7811	JJ=1
	GO TO 3411
781	IF(N.EQ.KSLA)N=ISEMI
C   FOR MOTIVIC TRANFORMATIONS

75	KN=INP(ML)
275	IF(KN.NE.IXX)GO TO 175
C  "X(" STARTS A 'MOTIF' BUT "X (" WON'T WORK!!!!
	IF(M.NE.0)GO TO 202
175	IF(KN.EQ.ISTAR)GO TO 202
C  FOR 2X3, 2*3, ETC.    CHECK THIS OUT.  6/74
C  FOR 'X' AND '*' WITHOUT SPACES.
	IF(N.EQ.ISEMI)GO TO 751
	IF(KN.EQ.IQT)GO TO 751
C SO YOU CAN TYPE .5"F7"  ETC.  (NO SPACE)
	IF(KN.NE.1)GO TO 2799
C WHEN IS INP(ML) (I.E. KN) SET TO 1?????
751	IF(ISKP.EQ.0)RETURN
202   IF(IDECI.NE.-1)GO TO 302    
      IDECI=0     
      GO TO 402   
302   IDECI=M-IDECI     
402   KN=0  
      IEXP=M-1    
      IF(M.LT.1)M=1     
      DO 171 K=1,M
	KV=10**IEXP
	IF(IEXP.EQ.0)KV=1
      KN=KN+IP(K)*KV 
171     IEXP=IEXP-1     
      A=10**IDECI 
	IF(IDECI.EQ.0)A=1.
	JJ=JJ+1
	A=KN/A*XMINUS
CC	VX(JJ)=KN/A*XMINUS
	IF(KPAR.EQ.0)GO TO 172
	A=-9999.-A/100.
	KPAR=0
C CHANGES P13 TO -9999.13, FOR EXAMPLE.
172	VX(JJ)=A
	IF(ISUB.EQ.1)RETURN
	IF(CODE.NE.-22.)XMINUS=1.
C  ONLY ONE - NEEDED FOR RHY.COMPOSITE
1310	IF(INP(ML).NE.1)GO TO 310
	VX(JJ+1)=VX(JJ)*2.
	JJ=JJ+1
	ML=ML+1
	GO TO 1310
206	ML=ML+2
3310	VX(1)=-99.
310      ISKP=0
        IF(N.NE.ISEMI)GO TO 999

    	RETURN
73	JJ=JJ+1
	 IF(INP(ML).EQ.IEE)GO TO 206    
C   NEXT IS FOR A REST ('R')  
      VX(JJ)=199.
731	N=INP(ML)
	IF(N.EQ.KSLA)RETURN
	IF(N.EQ.ISEMI)RETURN
	IF(N.NE.IBLA)GO TO 899
	ML=ML+1
	GO TO 731
  	END

      SUBROUTINE RANR(VX,K)
C   FOR RAN. SELEC. OF NOTES.  FINDS HIGHEST NOTE AND ADDS .999
      DIMENSION VX(1)
	J=K+1
	IF(VX(K).GT.VX(K+1))J=J-1
	IF(VX(J).GT.-9999.)VX(J)=VX(J)+.999
C AVOID TAMPERING WITH PARAM NUMS.
      END

	SUBROUTINE COLTTY(JNP,JT)
	COMMON /BLA/IBLA
	DIMENSION JNP(1)
	DO 1 K=72,1,-1
	JJ=JNP(K)
1	IF(JJ.NE.IBLA)GO TO 2
C SECOND SPACE IS A TAB.
	K=1
2	IF(JT.NE.20)GO TO 5
 	WRITE(JT,10)(JNP(L),L=1,K)
C WRITES 'TYPED' INPUT INTO FILE 'TYPD.DAT'
	RETURN 
5	WRITE(JT,11)(JNP(L),L=1,K)
10	FORMAT(80A1)
11	FORMAT(1X,80A1)
	END

	FUNCTION READER(JNP)
	DIMENSION JNP(80)
	COMMON /DEVS/ID1,ID21,JTYPE,ID23,ID20
	COMMON /TYP/JOUT,LN,KTYPE /ITYP/ITYP,JED /BLA/IBLA
	READER=0
	IF(ITYP.LT.0)GO TO 1
2203	FORMAT(' TYPE A LINE'/)
6 	WRITE(JTYPE,2203)
	READ(JTYPE,10)JNP
	IF(JED.LT.0)CALL COLTTY(JNP,20)
	GO TO 8
CKL1	IF(LN.NE.0)GO TO 5
1	READ(ID23,10,END=3)JNP
	IF(JNP(1).EQ.IBLA)GO TO 1
C IF 1ST CHAR. IS BLANK, GO READ ANOTHER LINE.
	GO TO 7
3	READER=-1
	RETURN 
CKL5	READ(ID23,11,END=3)LN,JNP
7	IF(KTYPE.EQ.0)CALL COLTTY(JNP,JOUT)
8	CALL CLEAN(LEND)
10	FORMAT(80A1)
CKL11	FORMAT(I,80A1)
	END

	SUBROUTINE CLEAN(LEND)
	COMMON /E/IQ(27),ISKP,XMINUS,AN,IEXP,LK,NNUM,JJ,JA,ISUB,NFLG,
	1 VX(70),IAMP,J,KN,JO,ML,CODE
	1 /INP/INP(1) /ALPH/IALPH(14),ISCA(12),IDAT(11)
	1 /BLA/IBLA,KSLA,ISEMI,MINUS,ISTAR,ICOMM,ICOL,IQUES,ILESS
	EQUIVALENCE (IAA,ISCA(10)),(IZZ,ISCA(7))
C  CLEAR THE END OF ARRAY
	M=72
	LEND=-1
	K=0
	DO 10 LL=73,80
	IF(INP(LL).EQ.IBLA)GO TO 10
C THIS 'ERR' IS JUST A WARNING
	CALL ERR(11)
	GO TO 1
10	CONTINUE
1	K=K+1
	NN=INP(K)
	IF(NN.EQ.ISEMI)GO TO 2
	IF(NN.EQ.KSLA)GO TO 2
	IF(NN.EQ.ILESS)GO TO 3
C  USE < FOR COMMENT--  AS IN MUS10
5	IF(NN.EQ.ICOMM)INP(K)=IBLA
CHANGE ALL COMMAS TO BLANKS
C**** FOR CHORD FEATURE 	IF(NN.EQ.':')CALL ERR(1)
8	IF(NN.NE.IQT)GO TO 4
7	K=K+1
	IF(INP(K).EQ.IQT)GO TO 4
	IF(K.LT.M)GO TO 7
	CALL ERR(5)
2	LEND=K
4	IF(K.LT.M)GO TO 1
3	IF(LEND.EQ.0)GO TO 9
	IF(LEND.GT.0)RETURN
9	IF(M.EQ.145)CALL ERR(2)
C LINES STARTING WITH P OR C CAN POSSIBLY HAVE NO SEMICOLON IN THEM.
6	CALL READER(INP(74))
C  GO READ ANOTHER LINE.
	M=INP(74)
	IF(M.GE.IAA.AND.M.LE.IZZ)CALL ERR(2)
C ONE EXTRA SPACE (M=145, NOT 144) FOR THE CRLF.
	M=145
	K=72
	INP(73)=IBLA
	GO TO 1
	END

	SUBROUTINE ERR(K)
	COMMON /ERRFLG/ERRFLG /TYP/JOUT /E/IQ(27),ISKP,XMINUS,AN,
	1 IEXP,LK,NNUM,JJ,JA,ISUB,NFLG
	1 /INP/INP(74) 
	COMMON /DEVS/ID1,ID21,JTYPE,ID23,ID20
	WRITE(JTYPE,999)INP
	IF(K.LE.0)GO TO 998
	GO TO(1,2,3,4,5,6,7,8,9,10,11,12,13)K
998	WRITE(JTYPE,199)K
199	FORMAT(' ***** ERROR!!  SOMEWHERE UP TO HERE. ***-FATAL-***'/)
	GO TO 200
1	WRITE(JTYPE,101)
	GO TO 200
101	FORMAT(' ***** COLON WANTED HERE? ***-FATAL-***'/)
CCC11	FORMAT(/' ILLEGAL COLON')
2	WRITE(JTYPE,102)
	GO TO 200
102	FORMAT(' ***** NO END MARK OR SEMICOLON ***-FATAL-***'/)
3	WRITE(JTYPE,103)
	GO TO 200
103	FORMAT(' ***** MORE THAN 2 PARENS OPEN ***-FATAL-***'/)
4	WRITE(JTYPE,104)
	GO TO 200
104	FORMAT(' ***** SOME NUMBER OUT OF BOUNDS ***-FATAL-***'/)
5	WRITE(JTYPE,105)
	GO TO 200
105	FORMAT(' ***** OPEN QUOTES ***-FATAL-***'/)
6	WRITE(JTYPE,106)
	GO TO 200
106	FORMAT(' ***** PARAM NUMBER ERROR: >99 ***-FATAL-***'/)
7	WRITE(JTYPE,107)
	GO TO 200
107	FORMAT(' ***** TOO MANY INSTS ***-FATAL-***'/)
8	WRITE(JTYPE,108)
	GO TO 200
108	FORMAT(' ***** MOTIVE ERROR ***-FATAL-***'/)
9	WRITE(JTYPE,109)
	GO TO 200
109	FORMAT(' ***** "MOVE" ERROR ***-FATAL-***'/)
10	WRITE(JTYPE,110)
	GO TO 200
110	FORMAT(' ***** MISSING "*"   ***-FATAL-***'/)
11	WRITE(JTYPE,111)
	RETURN
111	FORMAT(' **** WARNING: CHARACTERS FOUND BEYOND COLUMN 72'/)
12	WRITE(JTYPE,112)
	GO TO 200
999	FORMAT(1X74A1)
112	FORMAT(
     1' ***** WRONG NUM. OF ELEMENTS IN RAN. SELECTION. ***-FATAL-***'/)
13	WRITE(JTYPE,113)
113	FORMAT(' ***** WRONG FORMAT FOR P2. ***-FATAL-***'/)
200	ERRFLG=-1
C THIS WILL CAUSE EXIT BEFORE 'RUNIT'.
	END

	SUBROUTINE SHORT(KNP,K)
C  DON'T TYPE TRAILING BLANKS
	DIMENSION KNP(1)
	COMMON /BLA/IBLA
	DO 1 K=15,1,-1
1	IF(KNP(K).NE.IBLA)RETURN
	K=1
	END